Option Explicit
'u@Ҳ
Private WithEvents mySht As wsCls
Private Sub mySht_ColorChange(Target As Range)
    With Target
        MsgBox .Address & "IQܧF"
    End With
End Sub

Private Sub Worksheet_Activate()
    Set mysht = New wsCls
    With mysht
        .RFlg = True
        .Bclr = ActiveCell.Interior.ColorIndex
        .ColorCk Me
    End With
End Sub

Private Sub Worksheet_Deactivate()
    If mysht Is Nothing Then Exit Sub
    mysht.RFlg = False
    Set mysht = Nothing					'
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If mySht Is Nothing Then Exit Sub
    mySht.Bclr = ActiveCell.Interior.ColorIndex
End Sub

'OҲwsCls
Private BfrClr As Variant
Private RunFlg As Boolean
Public Event ColorChange(Target As Range)

Public Property Get RFlg() As Boolean
    RFlg = RunFlg
End Property

Public Property Let RFlg(myFlg As Boolean)
    RunFlg = myFlg
End Property

Public Property Get Bclr() As Variant
    Bclr = BfrClr
End Property


Public Property Let Bclr(CurClr As Variant)
    BfrClr = CurClr
End Property

Public Sub ColorCk(mysht As Worksheet)
   On Error GoTo Errlabel
   Do While RunFlg
         DoEvents
         With ActiveCell
             If .Interior.ColorIndex <> BfrClr Then
                 BfrClr = .Interior.ColorIndex
                 RaiseEvent ColorChange(mysht.Range(.Address))
             End If
         End With
     Loop
Errlabel:
     Exit Sub
End Sub
